home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / XLISP 2.0 / XLISP Tools / Utility (UL) / FILE-IO.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1988-04-07  |  1.4 KB  |  43 lines  |  [TEXT/ttxt]
  1. ;; Larry Mulcahy 1988
  2. ;; file I/O
  3.  
  4. (provide 'file-io)
  5. (require 'iteration "iter")
  6. (require 'string)
  7. (require 'character "char")
  8.  
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10. ; get-word
  11. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  12.  
  13. (defun get-word (&optional (stream *standard-input*)
  14.                  &key (character-predicate #'graphic-char-p))
  15.     (let ((acc nil))
  16.       (skip-bad-characters stream :character-predicate character-predicate)
  17.       (while (let ((c (peek-char nil stream)))
  18.                (and c (funcall character-predicate c)))
  19.         (push (read-char stream) acc))
  20.       (list-of-characters-to-string (reverse acc))))
  21.   
  22. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23. ; skip-bad-characters
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25.  
  26. (defun skip-bad-characters (&optional (stream *standard-input*)
  27.                             &key (character-predicate #'graphic-char-p))
  28.   (while (let ((c (peek-char nil stream)))
  29.            (and c (not (funcall character-predicate c))))
  30.     (read-char stream)))
  31.  
  32. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33. ; unique-filename
  34. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35.  
  36. (defun unique-filename ()
  37.   (let* ((s (number-to-string (time)))
  38.          (big (length s)))
  39.     (concatenate 'string
  40.       (subseq s 0 (- big 3))
  41.       "."
  42.       (subseq s (- big 3)))))
  43.